home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / getmx.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  6KB  |  173 lines
  1. /* getmx.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal cpyknt;
  12.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  13.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  14.         nwd16;
  15. } memmgr_;
  16.  
  17. #define memmgr_1 memmgr_
  18.  
  19. /* Table of constant values */
  20.  
  21. static integer c__3 = 3;
  22. static integer c__0 = 0;
  23.  
  24. /*<       subroutine getmx(ipntr,ksize,iwsize) >*/
  25. /* Subroutine */ int getmx_(ipntr, ksize, iwsize)
  26. integer *ipntr, *ksize, *iwsize;
  27. {
  28.     static integer need, madr;
  29.     extern integer locf_();
  30.     static integer morg, muse, msiz, ltab1;
  31.     extern /* Subroutine */ int copy4_();
  32.     static integer isize, jsize;
  33.     extern /* Subroutine */ int memadj_(), errmem_(), comprs_();
  34.     extern logical memptr_();
  35.     extern integer nxtmem_();
  36.     extern /* Subroutine */ int memory_();
  37.     static integer nwords;
  38.     extern integer nxtevn_();
  39.  
  40.     /* Parameter adjustments */
  41.     --ipntr;
  42.  
  43.     /* Function Body */
  44. /*<       implicit double precision (a-h,o-z) >*/
  45. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  46. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  47. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  48. /*<      2   nwd8,nwd16 >*/
  49. /*<       logical memptr >*/
  50. /*<       dimension ipntr(1) >*/
  51.  
  52. /* ***  getmem - get block */
  53.  
  54.  
  55. /*<       isize=ksize*iwsize >*/
  56.     isize = *ksize * *iwsize;
  57. /* ...  check for valid size */
  58. /*<       if (isize.ge.0) go to 5 >*/
  59.     if (isize >= 0) {
  60.     goto L5;
  61.     }
  62. /*<       memerr=2 >*/
  63.     memmgr_1.memerr = 2;
  64. /*<       call errmem(3,memerr,ipntr(1)) >*/
  65.     errmem_(&c__3, &memmgr_1.memerr, &ipntr[1]);
  66. /* ...  check for attempt to reallocate existing block */
  67. /*<     5 if (.not.memptr(ipntr(1))) go to 8 >*/
  68. L5:
  69.     if (! memptr_(&ipntr[1])) {
  70.     goto L8;
  71.     }
  72. /*<       memerr=3 >*/
  73.     memmgr_1.memerr = 3;
  74. /*<       call errmem(3,memerr,ipntr(1)) >*/
  75.     errmem_(&c__3, &memmgr_1.memerr, &ipntr[1]);
  76. /*<     8 jsize=nxtevn(isize) >*/
  77. L8:
  78.     jsize = nxtevn_(&isize);
  79. /*<       call comprs(0,ldval) >*/
  80.     comprs_(&c__0, &memmgr_1.ldval);
  81. /* ...  check if enough space already there */
  82. /*<       need=jsize+ntab-memavl >*/
  83.     need = jsize + memmgr_1.ntab - memmgr_1.memavl;
  84. /*<       if (need.le.0) go to 10 >*/
  85.     if (need <= 0) {
  86.     goto L10;
  87.     }
  88. /* ...  insufficient space -- bump memory size */
  89. /*<       need=nxtmem(need) >*/
  90.     need = nxtmem_(&need);
  91. /*<       icore=icore+need >*/
  92.     memmgr_1.icore += need;
  93. /*<       call memory >*/
  94.     memory_();
  95. /*<       if(memerr.ne.0) call errmem(3,memerr,ipntr(1)) >*/
  96.     if (memmgr_1.memerr != 0) {
  97.     errmem_(&c__3, &memmgr_1.memerr, &ipntr[1]);
  98.     }
  99. /*<       ltab1=ldval-ntab >*/
  100.     ltab1 = memmgr_1.ldval - memmgr_1.ntab;
  101. /*<       istack(ltab1+2)=istack(ltab1+2)+need >*/
  102.     memmgr_1.istack[ltab1 + 1] += need;
  103. /* ...  relocate block entry table */
  104. /*<       nwords=numblk*ntab >*/
  105.     nwords = memmgr_1.numblk * memmgr_1.ntab;
  106. /*<       cpyknt=cpyknt+dble(nwords) >*/
  107.     memmgr_1.cpyknt += (doublereal) nwords;
  108. /*<       call copy4(istack(loctab+1),istack(loctab+need+1),nwords) >*/
  109.     copy4_(&memmgr_1.istack[memmgr_1.loctab], &memmgr_1.istack[
  110.         memmgr_1.loctab + need], &nwords);
  111. /*<       loctab=loctab+need >*/
  112.     memmgr_1.loctab += need;
  113. /*<       ldval=ldval+need >*/
  114.     memmgr_1.ldval += need;
  115. /*<       memavl=memavl+need >*/
  116.     memmgr_1.memavl += need;
  117. /* ...  a block large enough now exists -- allocate it */
  118. /*<    10 ltab1=ldval-ntab >*/
  119. L10:
  120.     ltab1 = memmgr_1.ldval - memmgr_1.ntab;
  121. /*<       morg=istack(ltab1+1) >*/
  122.     morg = memmgr_1.istack[ltab1];
  123. /*<       msiz=istack(ltab1+2) >*/
  124.     msiz = memmgr_1.istack[ltab1 + 1];
  125. /*<       muse=istack(ltab1+3) >*/
  126.     muse = memmgr_1.istack[ltab1 + 2];
  127. /*<       muse=nxtevn(muse) >*/
  128.     muse = nxtevn_(&muse);
  129. /*<       madr=istack(ltab1+4) >*/
  130.     madr = memmgr_1.istack[ltab1 + 3];
  131. /* ...  construct new table entry */
  132. /*<    15 istack(ltab1+2)=muse >*/
  133. /* L15: */
  134.     memmgr_1.istack[ltab1 + 1] = muse;
  135. /*<       loctab=loctab-ntab >*/
  136.     memmgr_1.loctab -= memmgr_1.ntab;
  137. /*<       nwords=numblk*ntab >*/
  138.     nwords = memmgr_1.numblk * memmgr_1.ntab;
  139. /*<       cpyknt=cpyknt+dble(nwords) >*/
  140.     memmgr_1.cpyknt += (doublereal) nwords;
  141. /*<       call copy4(istack(loctab+ntab+1),istack(loctab+1),nwords) >*/
  142.     copy4_(&memmgr_1.istack[memmgr_1.loctab + memmgr_1.ntab], &
  143.         memmgr_1.istack[memmgr_1.loctab], &nwords);
  144. /*<       numblk=numblk+1 >*/
  145.     ++memmgr_1.numblk;
  146. /*<       memavl=memavl-ntab >*/
  147.     memmgr_1.memavl -= memmgr_1.ntab;
  148. /*<       istack(ltab1+1)=morg+muse >*/
  149.     memmgr_1.istack[ltab1] = morg + muse;
  150. /*<       istack(ltab1+2)=msiz-muse-ntab >*/
  151.     memmgr_1.istack[ltab1 + 1] = msiz - muse - memmgr_1.ntab;
  152. /* ...  set user size into table entry for this block */
  153. /*<    20 istack(ltab1+3)=isize >*/
  154. /* L20: */
  155.     memmgr_1.istack[ltab1 + 2] = isize;
  156. /*<       istack(ltab1+4)=locf(ipntr(1)) >*/
  157.     memmgr_1.istack[ltab1 + 3] = locf_(&ipntr[1]);
  158. /*<       istack(ltab1+5)=iwsize >*/
  159.     memmgr_1.istack[ltab1 + 4] = *iwsize;
  160. /*<       istack(ltab1+6)=0 >*/
  161.     memmgr_1.istack[ltab1 + 5] = 0;
  162. /*<       memavl=memavl-jsize >*/
  163.     memmgr_1.memavl -= jsize;
  164. /*<       ipntr(1)=istack(ltab1+1)/iwsize >*/
  165.     ipntr[1] = memmgr_1.istack[ltab1] / *iwsize;
  166. /*<       call memadj >*/
  167.     memadj_();
  168. /*<       return >*/
  169.     return 0;
  170. /*<       end >*/
  171. } /* getmx_ */
  172.  
  173.